home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / egamouse.zip / EGAMOUSE.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-04  |  8KB  |  281 lines
  1. Unit EgaMouse;
  2.  
  3. {*******************************************************************}
  4. {*                                                                 *}
  5. {*                   EgaMouse - EGA Mouse Unit                     *}
  6. {*                                                                 *}
  7. {*                    version 1.0, 02/02/88                        *}
  8. {*                by Eduardo Martins 73300,267                     *}
  9. {*                                                                 *}
  10. {*                        based on Mouse4                          *}
  11. {*                     version .9, 11/20/87                        *}
  12. {*                by Richard Sadowsky 74017,1670                   *}
  13. {*                                                                 *}
  14. {*             thanks to John Sierasky for helping me out          *}
  15. {*            with function CursorShape (mouse function 9)         *}
  16. {*                                                                 *}
  17. {*                 released to the public domain                   *}
  18. {*                                                                 *}
  19. {*******************************************************************}
  20.  
  21. Interface
  22.  
  23. Uses DOS;
  24.  
  25. type
  26.   MaskType = array[0..1, 0..15] of word;
  27.  
  28. const
  29.   LEFTPRESS        = 2;
  30.   LEFTREL          = 4;
  31.   RIGHTPRESS       = 8;
  32.   RIGHTREL         = 16;
  33.  
  34.   Standard         = 1;
  35.   PointingHand     = 2;
  36.   HourGlass        = 3;
  37.   DiagCross        = 4;
  38.   CheckMark        = 5;
  39.  
  40.  
  41.   Hand: MaskType =
  42.     (($E1FF,$E1FF,$E1FF,$E1FF,$E000,$E000,$E000,$0000,   { Screen Mask }
  43.       $0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000),
  44.  
  45.      ($1E00,$1200,$1200,$1200,$13FF,$1249,$1249,$F249,   { Cursor Mask }
  46.       $9001,$9001,$9001,$8001,$8001,$8001,$8001,$FFFF));
  47.  
  48.   Hour: MaskType =
  49.     (($0000,$0000,$0000,$0000,$8001,$C003,$E007,$F00F,
  50.       $E007,$C003,$8001,$0000,$0000,$0000,$0000,$FFFF),
  51.  
  52.      ($0000,$7FFE,$6006,$300C,$1818,$0C30,$0660,$03C0,
  53.       $0660,$0C30,$1998,$33CC,$67E6,$7FFE,$0000,$0000));
  54.  
  55.    Stand: MaskType =
  56.      (($3FFF,$1FFF,$0FFF,$07FF,$03FF,$01FF,$00FF,$007F,
  57.        $003F,$001F,$01FF,$10FF,$30FF,$F87F,$F87F,$FC7F),
  58.  
  59.       ($0000,$4000,$6000,$7000,$7800,$7C00,$7E00,$7F00,
  60.        $7F80,$7C00,$6C00,$4600,$0600,$0300,$0300,$0000));
  61.  
  62.    DiagC: MaskType =
  63.      (($07E0,$0180,$0000,$C003,$F00F,$C003,$0000,$0180,
  64.        $07E0,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF),
  65.  
  66.       ($0000,$700E,$1C38,$0660,$03C0,$0660,$1C38,$700E,
  67.        $0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000));
  68.  
  69.    Check: MaskType =
  70.      (($FFF0,$FFE0,$FFC0,$FF03,$0607,$000F,$001F,$C03F,
  71.        $F07F,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF),
  72.  
  73.        ($0000,$0006,$000C,$0018,$0030,$0060,$70C0,$1D80,
  74.         $0700,$0000,$0000,$0000,$0000,$0000,$0000,$0000));
  75.  
  76.  
  77.  
  78. var
  79.   Mouse_Reg        : Registers;
  80.   Mouse_Installed  : Boolean;
  81.   Mouse_Error      : Word;
  82.   Mask             : MaskType;
  83.  
  84. function InitMouse : Word;
  85. { Function 0 - Initialize mouse software and hardware }
  86.  
  87. procedure ShowMouse;
  88. { function 1 - show mouse cursor }
  89.  
  90. procedure HideMouse;
  91. { function 2 - hide mouse cursor }
  92.  
  93. function MousePosition(var MouseX,MouseY : Word) : Word;
  94. { function 3 - return mouse position and button status }
  95. { X and Y values scaled for 640 x 350 EGA mode }
  96.  
  97. procedure SetMousePosition(mousex, mousey: Word);
  98. { function 4 - sets mouse position  }
  99. { X and Y values scaled for 640 x 350 EGA mode }
  100.  
  101. function MousePress(button: Word;
  102.                      var count, lastx, lasty: Word): Word;
  103. { function 5 - gets button press information  }
  104. { X and Y values scaled for 640 x 350 EGA mode }
  105.  
  106. function MouseRelease(button: Word;
  107.                        var count, lastx, lasty: Word): Word;
  108. { function 6 - gets button release information  }
  109. { X and Y values scaled for 640 x 350 EGA mode }
  110.  
  111. procedure SetMouseXY(x1,y1,x2,y2: Word);
  112. { functions 7 and 8 - sets min/max values for horizontal/vertical  }
  113. { X and Y values scaled for 640 x 350 EGA mode }
  114.  
  115. procedure RestoreMouseXY;
  116. { functions 7 and 8 - restores min/max values for CGA screen }
  117.  
  118. procedure CursorShape(Shape: integer);
  119. { function 9 - sets the graphics cursor shape }
  120.  
  121. procedure SetPixeltoMickey(Horiz,Verti : Word);
  122. { function 15 - sets the mickey to pixel ratio }
  123.  
  124.  
  125. implementation
  126.  
  127. function InitMouse : Word;
  128. { Function 0 - Initialize mouse software and hardware }
  129.  
  130. begin
  131.   with Mouse_Reg do
  132.     Ax := 0;
  133.   Intr($33,Mouse_Reg);
  134.   InitMouse := Mouse_Reg.Ax;
  135. end;
  136.  
  137. procedure ShowMouse;
  138. { function 1 - show mouse cursor }
  139.  
  140. begin
  141.   Mouse_Reg.Ax := 1;
  142.   Intr($33,Mouse_Reg);
  143. end;
  144.  
  145. procedure HideMouse;
  146. { function 2 - hide mouse cursor }
  147.  
  148. begin
  149.   Mouse_Reg.AX := 2;
  150.   Intr($33,Mouse_Reg);
  151. end;
  152.  
  153. function MousePosition(var MouseX,MouseY : Word) : Word;
  154. { function 3 - return mouse position and button status }
  155. { X and Y values scaled for 640 x 350 EGA mode }
  156.  
  157. begin
  158.   Mouse_Reg.Ax := 3;
  159.   Intr($33,Mouse_Reg);
  160.   with Mouse_Reg do begin
  161.     MouseX := Succ(Cx);
  162.     MouseY := Succ(Dx);
  163.     MousePosition := Bx;
  164.   end;
  165. end;
  166.  
  167. procedure SetMousePosition(mousex, mousey: Word);
  168. { function 4 - sets mouse position  }
  169. { X and Y values scaled for 640 x 350 EGA mode }
  170.  
  171. begin
  172.   Mouse_Reg.ax:=4;
  173.   Mouse_Reg.cx:=Pred(mousex);
  174.   Mouse_Reg.dx:=Pred(mousey);
  175.   intr($33,Mouse_Reg);
  176. end;
  177.  
  178. function MousePress(button: Word;
  179.                      var count, lastx, lasty: Word): Word;
  180. { function 5 - gets button press information  }
  181. { X and Y values scaled for 640 x 350 EGA mode }
  182.  
  183. begin
  184.   Mouse_Reg.ax:=5;
  185.   Mouse_Reg.bx:=button;
  186.   intr($33,Mouse_Reg);;
  187.   mousepress:=Mouse_Reg.ax;
  188.   count:=Mouse_Reg.bx;
  189.   lastx:=Succ(Mouse_Reg.cx );
  190.   lasty:=Succ(Mouse_Reg.dx );
  191. end;
  192.  
  193. function MouseRelease(button: Word;
  194.                        var count, lastx, lasty: Word): Word;
  195. { function 6 - gets button release information  }
  196. { X and Y values scaled for 640 x 350 EGA mode }
  197.  
  198. begin
  199.   Mouse_Reg.ax:=6;
  200.   Mouse_Reg.bx:=button;
  201.   intr($33,Mouse_Reg);;
  202.   mouserelease:=Mouse_Reg.ax;
  203.   count:=Mouse_Reg.bx;
  204.   lastx := Succ(Mouse_Reg.cx );
  205.   lasty := Succ(Mouse_Reg.dx );
  206. end;
  207.  
  208. procedure SetMouseXY(x1,y1,x2,y2: Word);
  209. { functions 7 and 8 - sets min/max values for horizontal/vertical  }
  210. { X and Y values scaled for 640 x 350 EGA mode }
  211.  
  212. begin
  213.   Mouse_Reg.ax:=7;
  214.   Mouse_Reg.cx:=Pred(x1);
  215.   Mouse_Reg.dx:=Pred(x2);
  216.   intr($33,Mouse_Reg);
  217.   Mouse_Reg.ax:=8;
  218.   Mouse_Reg.cx:=Pred(y1);
  219.   Mouse_Reg.dx:=Pred(y2);
  220.   intr($33,Mouse_Reg);
  221. end;
  222.  
  223. procedure RestoreMouseXY;
  224. { functions 7 and 8 - restores min/max values for EGA screen }
  225.  
  226. begin
  227.   Mouse_Reg.ax:=7;
  228.   Mouse_Reg.cx:=0;
  229.   Mouse_Reg.dx:=639;
  230.   intr($33,Mouse_Reg);
  231.   Mouse_Reg.ax:=8;
  232.   Mouse_Reg.cx:=0;
  233.   Mouse_Reg.dx:=349;
  234.   intr($33,Mouse_Reg);
  235. end;
  236.  
  237.  
  238. procedure CursorShape(Shape:integer);
  239. { function 9 - sets the graphics cursor shape }
  240.  
  241.  
  242. begin
  243.  
  244.    case Shape of
  245.       1: Mask := Stand;
  246.       2: Mask := Hand;
  247.       3: Mask := Hour;
  248.       4: Mask := DiagC;
  249.       5: Mask := Check
  250.    end;
  251.  
  252.  
  253.   with Mouse_Reg do
  254.   begin
  255.     AX := 9;
  256.     BX := 0;
  257.     CX := 0;
  258.     ES := Seg(Mask);
  259.     DX := Ofs(Mask);
  260.     Intr($33, Mouse_Reg);
  261.   end;
  262. end;
  263.  
  264.  
  265. procedure SetPixeltoMickey(Horiz,Verti : Word);
  266. { function 15 - sets the mickey to pixel ratio }
  267.  
  268. begin
  269.   with Mouse_Reg do begin
  270.     Ax := 15;
  271.     Cx := Horiz;
  272.     Dx := Verti;
  273.   end;
  274.   Intr($33,Mouse_Reg)
  275. end;
  276.  
  277. begin
  278.   Mouse_Error := InitMouse;
  279.   Mouse_Installed := Mouse_Error = 65535;
  280. end.
  281.